home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / MacHaskell 2.2 / progs / lib / hbc / ListUtil.hs < prev    next >
Encoding:
Text File  |  1994-09-27  |  1.6 KB  |  48 lines  |  [TEXT/YHS2]
  1. module ListUtil(assoc, concatMap, unfoldr, mapAccuml, union, intersection, chopList, assocDef, lookup, Maybe..) where
  2.  
  3. -- Lookup an item in an association list.  Apply a function to it if it is found, otherwise return a default value.
  4. assoc :: (Eq c) => (a -> b) -> b -> [(c, a)] -> c -> b
  5. assoc f d [] x                       = d
  6. assoc f d ((x',y):xys) x | x' == x   = f y
  7.                          | otherwise = assoc f d xys x
  8.  
  9. -- Map and concatename results.
  10. concatMap :: (a -> [b]) -> [a] -> [b]
  11. concatMap f []       = []
  12. concatMap f (x:xs) =
  13.     case f x of
  14.     [] -> concatMap f xs
  15.     ys -> ys ++ concatMap f xs
  16.  
  17. -- Repeatedly extract (and transform) values until a predicate hold.  Return the list of values.
  18. unfoldr :: (a -> (b, a)) -> (a -> Bool) -> a -> [b]
  19. unfoldr f p x | p x       = []
  20.           | otherwise = y:unfoldr f p x'
  21.                   where (y, x') = f x
  22.  
  23. -- Map, but plumb a state through the map operation.
  24. mapAccuml :: (a -> b -> (a, c)) -> a -> [b] -> (a, [c])
  25. mapAccuml f s []     = (s, [])
  26. mapAccuml f s (x:xs) = (s'', y:ys)
  27.                where (s',  y)  = f s x
  28.                  (s'', ys) = mapAccuml f s' xs
  29.  
  30. -- Union of sets as lists.
  31. union :: (Eq a) => [a] -> [a] -> [a]
  32. union xs ys = xs ++ (ys \\ xs)
  33.  
  34. -- Intersection of sets as lists.
  35. intersection :: (Eq a) => [a] -> [a] -> [a]
  36. intersection xs ys = [x | x<-xs, x `elem` ys]
  37.  
  38. --- Functions derived from those above
  39.  
  40. chopList :: ([a] -> (b, [a])) -> [a] -> [b]
  41. chopList f l = unfoldr f null l
  42.  
  43. assocDef :: (Eq a) => [(a, b)] -> b -> a -> b
  44. assocDef l d x = assoc id d l x
  45.  
  46. lookup :: (Eq a) => [(a, b)] -> a -> Maybe b
  47. lookup l x = assoc Just Nothing l x
  48.